home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 7 / Amiga Format AFCD07 (Dec 1996, Issue 91).iso / serious / shareware / programming / emacs-complete / fsf / emacs / lisp / reporter.el < prev    next >
Lisp/Scheme  |  1994-07-18  |  13KB  |  376 lines
  1. ;;; reporter.el --- customizable bug reporting of lisp programs
  2.  
  3. ;; Author: 1993 Barry A. Warsaw, Century Computing Inc. <bwarsaw@cen.com>
  4. ;; Maintainer:      bwarsaw@cen.com
  5. ;; Created:         19-Apr-1993
  6. ;; Version:         2.12
  7. ;; Last Modified:   1994/07/06 14:55:39
  8. ;; Keywords: bug reports lisp
  9.  
  10. ;; Copyright (C) 1993 1994 Barry A. Warsaw
  11. ;; Copyright (C) 1993 1994 Free Software Foundation, Inc.
  12.  
  13. ;; This file is part of GNU Emacs.
  14.  
  15. ;; GNU Emacs is free software; you can redistribute it and/or modify
  16. ;; it under the terms of the GNU General Public License as published by
  17. ;; the Free Software Foundation; either version 2, or (at your option)
  18. ;; any later version.
  19.  
  20. ;; GNU Emacs is distributed in the hope that it will be useful,
  21. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23. ;; GNU General Public License for more details.
  24.  
  25. ;; You should have received a copy of the GNU General Public License
  26. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  27. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  28.  
  29. ;;; Commentary:
  30. ;;
  31. ;; Introduction
  32. ;; ============
  33. ;; This program is for lisp package authors and can be used to ease
  34. ;; reporting of bugs.  When invoked, reporter-submit-bug-report will
  35. ;; set up a mail buffer with the appropriate bug report address,
  36. ;; including a lisp expression the maintainer of the package can eval
  37. ;; to completely reproduce the environment in which the bug was
  38. ;; observed (e.g. by using eval-last-sexp). This package proved especially
  39. ;; useful during my development of cc-mode.el, which is highly dependent
  40. ;; on its configuration variables.
  41. ;;
  42. ;; Do a "C-h f reporter-submit-bug-report" for more information.
  43. ;; Here's an example usage:
  44. ;;
  45. ;;(defconst mypkg-version "9.801")
  46. ;;(defconst mypkg-maintainer-address "mypkg-help@foo.com")
  47. ;;(defun mypkg-submit-bug-report ()
  48. ;;  "Submit via mail a bug report on mypkg"
  49. ;;  (interactive)
  50. ;;  (require 'reporter)
  51. ;;  (reporter-submit-bug-report
  52. ;;   mypkg-maintainer-address
  53. ;;   (concat "mypkg.el " mypkg-version)
  54. ;;   (list 'mypkg-variable-1
  55. ;;         'mypkg-variable-2
  56. ;;         ;; ...
  57. ;;         'mypkg-variable-last)))
  58.  
  59. ;; Major differences since version 1:
  60. ;; ==================================
  61. ;; * More robust in the face of void variables
  62. ;; * New interface controlling variable reporter-prompt-for-summary-p
  63. ;; * pretty-printing of lists!
  64.  
  65.  
  66. ;; Mailing List
  67. ;; ============
  68. ;; I've set up a mailing list to report bugs or suggest enhancements,
  69. ;; etc. This list's intended audience is elisp package authors who are
  70. ;; using reporter and want to stay current with releases. Here are the
  71. ;; relevent addresses:
  72. ;;
  73. ;; Administrivia: reporter-request@anthem.nlm.nih.gov
  74. ;; Submissions:   reporter@anthem.nlm.nih.gov
  75.  
  76. ;; LCD Archive Entry:
  77. ;; reporter|Barry A. Warsaw|bwarsaw@cen.com|
  78. ;; Customizable bug reporting of lisp programs.|
  79. ;; 1994/07/06 14:55:39|2.12|~/misc/reporter.el.Z|
  80.  
  81. ;;; Code:
  82.  
  83.  
  84. ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
  85. ;; user defined variables
  86.  
  87. (defvar reporter-mailer '(vm-mail mail)
  88.   "*Mail package to use to generate bug report buffer.
  89. This can either be a function symbol or a list of function symbols.
  90. If a list, it tries to use each specified mailer in order until an
  91. existing one is found.")
  92.  
  93. (defvar reporter-prompt-for-summary-p nil
  94.   "Interface variable controlling prompting for problem summary.
  95. When non-nil, `reporter-submit-bug-report' prompts the user for a
  96. brief summary of the problem, and puts this summary on the Subject:
  97. line.
  98.  
  99. Default behavior is to not prompt (i.e. nil). If you want reporter to
  100. prompt, you should `let' bind this variable to t before calling
  101. `reporter-submit-bug-report'.  Note that this variable is not
  102. buffer-local so you should never just `setq' it.")
  103.  
  104.  
  105. ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  106. ;; end of user defined variables
  107.  
  108. (defvar reporter-eval-buffer nil
  109.   "Buffer to retrieve variable's value from.
  110. This is necessary to properly support the printing of buffer-local
  111. variables.  Current buffer will always be the mail buffer being
  112. composed.")
  113.  
  114. (defconst reporter-version "2.12"
  115.   "Reporter version number.")
  116.  
  117. (defvar reporter-initial-text nil
  118.   "The automatically created initial text of a bug report.")
  119. (make-variable-buffer-local 'reporter-initial-text)
  120.  
  121.  
  122.  
  123. (defun reporter-dump-variable (varsym mailbuf)
  124.   ;; Pretty-print the value of the variable in symbol VARSYM.  MAILBUF
  125.   ;; is the mail buffer being composed
  126.   (condition-case nil
  127.       (let ((val (save-excursion
  128.            (set-buffer reporter-eval-buffer)
  129.            (symbol-value varsym)))
  130.         (sym (symbol-name varsym))
  131.         (print-escape-newlines t)
  132.         (here (point)))
  133.     (insert "     " sym " "
  134.         (cond
  135.          ((memq val '(t nil)) "")
  136.          ((listp val) "'")
  137.          ((symbolp val) "'")
  138.          (t ""))
  139.         (prin1-to-string val))
  140.     ;; clean up lists, but only if the line as printed was long
  141.     ;; enough to wrap
  142.     (if (and (listp val)
  143.          (< (window-width) (current-column)))
  144.         (save-excursion
  145.           (goto-char here)
  146.           ;; skip past the symbol name
  147.           (down-list 1)
  148.           (condition-case nil    ; actual loop exit
  149.           (while t
  150.             (forward-sexp 1)
  151.             (insert "\n")
  152.             ;; if the sexp is longer than a single line then
  153.             ;; fill it to fill-column
  154.             (if (< (window-width)
  155.                (save-excursion
  156.                  (forward-char -1)
  157.                  (current-column)))
  158.             (let (stop)
  159.               (unwind-protect
  160.                   (setq stop (point-marker))
  161.                   (forward-line -1)
  162.                   (fill-region (point) (progn (end-of-line)
  163.                               (point)))
  164.                   ;; consume extra newline left by fill-region
  165.                   (delete-char 1)
  166.                   (goto-char stop))
  167.               (set-marker stop nil)))
  168.             (lisp-indent-line))
  169.         (error nil))))
  170.     (insert "\n"))
  171.     (void-variable
  172.      (save-excursion
  173.        (set-buffer mailbuf)
  174.        (mail-position-on-field "X-Reporter-Void-Vars-Found")
  175.        (end-of-line)
  176.        (insert (symbol-name varsym) " ")))
  177.     (error (error))))
  178.  
  179. (defun reporter-dump-state (pkgname varlist pre-hooks post-hooks)
  180.   ;; Dump the state of the mode specific variables.
  181.   ;; PKGNAME contains the name of the mode as it will appear in the bug
  182.   ;; report (you must explicitly concat any version numbers).
  183.  
  184.   ;; VARLIST is the list of variables to dump.  Each element in
  185.   ;; VARLIST can be a variable symbol, or a cons cell.  If a symbol,
  186.   ;; this will be passed to `reporter-dump-variable' for insertion
  187.   ;; into the mail buffer.  If a cons cell, the car must be a variable
  188.   ;; symbol and the cdr must be a function which will be `funcall'd
  189.   ;; with arguments the symbol and the mail buffer being composed. Use
  190.   ;; this to write your own custom variable value printers for
  191.   ;; specific variables.
  192.  
  193.   ;; Note that the global variable `reporter-eval-buffer' will be bound to
  194.   ;; the buffer in which `reporter-submit-bug-report' was invoked.  If you
  195.   ;; want to print the value of a buffer local variable, you should wrap
  196.   ;; the `eval' call in your custom printer inside a `set-buffer' (and
  197.   ;; probably a `save-excursion'). `reporter-dump-variable' handles this
  198.   ;; properly.
  199.  
  200.   ;; PRE-HOOKS is run after the emacs-version and PKGNAME are inserted, but
  201.   ;; before the VARLIST is dumped.  POST-HOOKS is run after the VARLIST is
  202.   ;; dumped.
  203.   (let ((buffer (current-buffer)))
  204.     (set-buffer buffer)
  205.     (insert "Emacs  : " (emacs-version) "\n")
  206.     (and pkgname
  207.      (insert "Package: " pkgname "\n"))
  208.     (run-hooks 'pre-hooks)
  209.     (if (not varlist)
  210.     nil
  211.       (insert "\ncurrent state:\n==============\n")
  212.       ;; create an emacs-lisp-mode buffer to contain the output, which
  213.       ;; we'll later insert into the mail buffer
  214.       (condition-case fault
  215.       (let ((mailbuf (current-buffer))
  216.         (elbuf (get-buffer-create " *tmp-reporter-buffer*")))
  217.         (save-excursion
  218.           (set-buffer elbuf)
  219.           (emacs-lisp-mode)
  220.           (erase-buffer)
  221.           (insert "(setq\n")
  222.           (lisp-indent-line)
  223.           (mapcar
  224.            (function
  225.         (lambda (varsym-or-cons-cell)
  226.           (let ((varsym (or (car-safe varsym-or-cons-cell)
  227.                     varsym-or-cons-cell))
  228.             (printer (or (cdr-safe varsym-or-cons-cell)
  229.                      'reporter-dump-variable)))
  230.             (funcall printer varsym mailbuf)
  231.             )))
  232.            varlist)
  233.           (insert ")\n")
  234.           (beginning-of-defun)
  235.           (indent-sexp))
  236.         (insert-buffer elbuf))
  237.     (error
  238.      (insert "State could not be dumped due to the following error:\n\n"
  239.          (format "%s" fault)
  240.          "\n\nYou should still send this bug report."))))
  241.     (run-hooks 'post-hooks)
  242.     ))
  243.  
  244.  
  245. (defun reporter-calculate-separator ()
  246.   ;; returns the string regexp matching the mail separator
  247.   (save-excursion
  248.     (re-search-forward
  249.      (concat
  250.       "^\\("                ;beginning of line
  251.       (mapconcat
  252.        'identity
  253.        (list "[\t ]*"            ;simple SMTP form
  254.          "-+"            ;mh-e form
  255.          (regexp-quote 
  256.           mail-header-separator))    ;sendmail.el form
  257.        "\\|")                ;or them together
  258.       "\\)$")                ;end of line
  259.      nil
  260.      'move)                ;search for and move
  261.     (buffer-substring (match-beginning 0) (match-end 0))))
  262.  
  263. ;;;###autoload
  264. (defun reporter-submit-bug-report
  265.   (address pkgname varlist &optional pre-hooks post-hooks salutation)
  266.   ;; Submit a bug report via mail.
  267.  
  268.   ;; ADDRESS is the email address for the package's maintainer. PKGNAME is
  269.   ;; the name of the mode (you must explicitly concat any version numbers).
  270.   ;; VARLIST is the list of variables to dump (see `reporter-dump-state'
  271.   ;; for details). Optional PRE-HOOKS and POST-HOOKS are passed to
  272.   ;; `reporter-dump-state'. Optional SALUTATION is inserted at the top of the
  273.   ;; mail buffer, and point is left after the salutation.
  274.  
  275.   ;; This function will prompt for a summary if
  276.   ;; reporter-prompt-for-summary-p is non-nil.
  277.  
  278.   ;; The mailer used is described in the variable `reporter-mailer'.
  279.   (let ((reporter-eval-buffer (current-buffer))
  280.     final-resting-place
  281.     after-sep-pos
  282.     (problem (and reporter-prompt-for-summary-p
  283.               (read-string "(Very) brief summary of problem: ")))
  284.     (mailbuf
  285.      (progn
  286.        (call-interactively
  287.         (if (nlistp reporter-mailer)
  288.         reporter-mailer
  289.           (let ((mlist reporter-mailer)
  290.             (mailer nil))
  291.         (while mlist
  292.           (if (commandp (car mlist))
  293.               (setq mailer (car mlist)
  294.                 mlist nil)
  295.             (setq mlist (cdr mlist))))
  296.         (if (not mailer)
  297.             (error
  298.              "variable `%s' does not contain a command for mailing."
  299.              "reporter-mailer"))
  300.         mailer)))
  301.        (current-buffer))))
  302.     (require 'sendmail)
  303.     (pop-to-buffer reporter-eval-buffer)
  304.     (pop-to-buffer mailbuf)
  305.     (goto-char (point-min))
  306.     ;; different mailers use different separators, some may not even
  307.     ;; use m-h-s, but sendmail.el stuff must have m-h-s bound.
  308.     (let ((mail-header-separator (reporter-calculate-separator)))
  309.       (mail-position-on-field "to")
  310.       (insert address)
  311.       ;; insert problem summary if available
  312.       (if (and reporter-prompt-for-summary-p problem pkgname)
  313.       (progn
  314.         (mail-position-on-field "subject")
  315.         (insert pkgname "; " problem)))
  316.       (re-search-forward mail-header-separator (point-max) 'move)
  317.       (forward-line 1)
  318.       (setq after-sep-pos (point))
  319.       (and salutation (insert "\n" salutation "\n\n"))
  320.       (unwind-protect
  321.       (progn
  322.         (setq final-resting-place (point-marker))
  323.         (insert "\n\n")
  324.         (reporter-dump-state pkgname varlist pre-hooks post-hooks)
  325.         (goto-char final-resting-place))
  326.     (set-marker final-resting-place nil)))
  327.  
  328.     ;; save initial text and set up the `no-empty-submission' hook.
  329.     ;; This only works for mailers that support mail-send-hook,
  330.     ;; e.g. sendmail.el
  331.     (if (fboundp 'add-hook)
  332.     (progn
  333.       (save-excursion
  334.         (goto-char (point-max))
  335.         (skip-chars-backward " \t\n")
  336.         (setq reporter-initial-text
  337.           (buffer-substring after-sep-pos (point))))
  338.       (make-variable-buffer-local 'mail-send-hook)
  339.       (add-hook 'mail-send-hook 'reporter-bug-hook)))
  340.  
  341.     ;; minibuf message
  342.     ;; C-c C-c can't be generalized because they don't always run
  343.     ;; mail-send-and-exit. E.g. vm-mail-send-and-exit.  I don't want
  344.     ;; to hard code these.
  345.     (let* ((sendkey "C-c C-c")
  346.        (killkey-whereis (where-is-internal 'kill-buffer nil t))
  347.        (killkey (if killkey-whereis
  348.             (key-description killkey-whereis)
  349.               "M-x kill-buffer")))
  350.       (message "Please type in your report. Hit %s to send, %s to abort."
  351.            sendkey killkey))
  352.     ))
  353.  
  354. (defun reporter-bug-hook ()
  355.   ;; prohibit sending mail if empty bug report
  356.   (let ((after-sep-pos
  357.      (save-excursion
  358.        (beginning-of-buffer)
  359.        (re-search-forward (reporter-calculate-separator) (point-max) 'move)
  360.        (forward-line 1)
  361.        (point))))
  362.     (save-excursion
  363.       (goto-char (point-max))
  364.       (skip-chars-backward " \t\n")
  365.       (if (and (= (- (point) after-sep-pos)
  366.           (length reporter-initial-text))
  367.            (string= (buffer-substring after-sep-pos (point))
  368.             reporter-initial-text))
  369.       (error "Empty bug report cannot be sent."))
  370.       )))
  371.  
  372.  
  373. (provide 'reporter)
  374.  
  375. ;;; reporter.el ends here
  376.